Projet final
Julien Leblanc, Léa Kluhs
2023-04-24
Partie I
Liste des packages nécessaires.
library(readr)
library(tidyverse)
library(readxl)
library(FactoMineR)
library(factoextra)
library(arsenal)
library(knitr)
library(dplyr)
library(ggplot2)
library(clean)
library(gtsummary)
library(clValid)
library(mclust)
library(ggpubr)
source(url("https://raw.githubusercontent.com/larmarange/JLutils/master/R/clustering.R"))
library(reshape2)Téléchargement de notre dataset pour lequel nous avons renommé les noms des colonnes.
data <- read_csv("wdbc.data",
col_names = c("ID number",
"Diagnosis",
"radius_mean",
"texture_mean",
"perimeter_mean",
"area_mean","smoothness_mean",
"compactness_mean",
"concavity_mean",
"concave_points_mean",
"symmetry_mean",
"fractal_dimension_mean",
"radius_SE","texture_SE",
"perimeter_SE","area_SE",
"smoothness_SE",
"compactness_SE",
"concavity_SE",
"concave_points_SE",
"symmetry_SE",
"fractal_dimension_SE",
"radius_worst",
"texture_worst",
"perimeter_worst",
"area_worst",
"smoothness_worst",
"compactness_worst",
"concavity_worst",
"concave_points_worst",
"symmetry_worst",
"fractal_dimension_worst"))
clean_data <- data %>%
select(c(contains("_mean"), Diagnosis)) %>%
drop_na()Question n°1
Tout d’abord voici ci-dessous les différentes variables de notre dataset.
glimpse(data)## Rows: 569
## Columns: 32
## $ `ID number` <dbl> 842302, 842517, 84300903, 84348301, 84358402, …
## $ Diagnosis <chr> "M", "M", "M", "M", "M", "M", "M", "M", "M", "…
## $ radius_mean <dbl> 17.990, 20.570, 19.690, 11.420, 20.290, 12.450…
## $ texture_mean <dbl> 10.38, 17.77, 21.25, 20.38, 14.34, 15.70, 19.9…
## $ perimeter_mean <dbl> 122.80, 132.90, 130.00, 77.58, 135.10, 82.57, …
## $ area_mean <dbl> 1001.0, 1326.0, 1203.0, 386.1, 1297.0, 477.1, …
## $ smoothness_mean <dbl> 0.11840, 0.08474, 0.10960, 0.14250, 0.10030, 0…
## $ compactness_mean <dbl> 0.27760, 0.07864, 0.15990, 0.28390, 0.13280, 0…
## $ concavity_mean <dbl> 0.30010, 0.08690, 0.19740, 0.24140, 0.19800, 0…
## $ concave_points_mean <dbl> 0.14710, 0.07017, 0.12790, 0.10520, 0.10430, 0…
## $ symmetry_mean <dbl> 0.2419, 0.1812, 0.2069, 0.2597, 0.1809, 0.2087…
## $ fractal_dimension_mean <dbl> 0.07871, 0.05667, 0.05999, 0.09744, 0.05883, 0…
## $ radius_SE <dbl> 1.0950, 0.5435, 0.7456, 0.4956, 0.7572, 0.3345…
## $ texture_SE <dbl> 0.9053, 0.7339, 0.7869, 1.1560, 0.7813, 0.8902…
## $ perimeter_SE <dbl> 8.589, 3.398, 4.585, 3.445, 5.438, 2.217, 3.18…
## $ area_SE <dbl> 153.40, 74.08, 94.03, 27.23, 94.44, 27.19, 53.…
## $ smoothness_SE <dbl> 0.006399, 0.005225, 0.006150, 0.009110, 0.0114…
## $ compactness_SE <dbl> 0.049040, 0.013080, 0.040060, 0.074580, 0.0246…
## $ concavity_SE <dbl> 0.05373, 0.01860, 0.03832, 0.05661, 0.05688, 0…
## $ concave_points_SE <dbl> 0.015870, 0.013400, 0.020580, 0.018670, 0.0188…
## $ symmetry_SE <dbl> 0.03003, 0.01389, 0.02250, 0.05963, 0.01756, 0…
## $ fractal_dimension_SE <dbl> 0.006193, 0.003532, 0.004571, 0.009208, 0.0051…
## $ radius_worst <dbl> 25.38, 24.99, 23.57, 14.91, 22.54, 15.47, 22.8…
## $ texture_worst <dbl> 17.33, 23.41, 25.53, 26.50, 16.67, 23.75, 27.6…
## $ perimeter_worst <dbl> 184.60, 158.80, 152.50, 98.87, 152.20, 103.40,…
## $ area_worst <dbl> 2019.0, 1956.0, 1709.0, 567.7, 1575.0, 741.6, …
## $ smoothness_worst <dbl> 0.1622, 0.1238, 0.1444, 0.2098, 0.1374, 0.1791…
## $ compactness_worst <dbl> 0.6656, 0.1866, 0.4245, 0.8663, 0.2050, 0.5249…
## $ concavity_worst <dbl> 0.71190, 0.24160, 0.45040, 0.68690, 0.40000, 0…
## $ concave_points_worst <dbl> 0.26540, 0.18600, 0.24300, 0.25750, 0.16250, 0…
## $ symmetry_worst <dbl> 0.4601, 0.2750, 0.3613, 0.6638, 0.2364, 0.3985…
## $ fractal_dimension_worst <dbl> 0.11890, 0.08902, 0.08758, 0.17300, 0.07678, 0…Voici ci-dessous une petit test statistique sur les variables que nous allons étudier.
data$Diagnosis <- as.factor(data$Diagnosis)
summary(data)## ID number Diagnosis radius_mean texture_mean
## Min. : 8670 B:357 Min. : 6.981 Min. : 9.71
## 1st Qu.: 869218 M:212 1st Qu.:11.700 1st Qu.:16.17
## Median : 906024 Median :13.370 Median :18.84
## Mean : 30371831 Mean :14.127 Mean :19.29
## 3rd Qu.: 8813129 3rd Qu.:15.780 3rd Qu.:21.80
## Max. :911320502 Max. :28.110 Max. :39.28
## perimeter_mean area_mean smoothness_mean compactness_mean
## Min. : 43.79 Min. : 143.5 Min. :0.05263 Min. :0.01938
## 1st Qu.: 75.17 1st Qu.: 420.3 1st Qu.:0.08637 1st Qu.:0.06492
## Median : 86.24 Median : 551.1 Median :0.09587 Median :0.09263
## Mean : 91.97 Mean : 654.9 Mean :0.09636 Mean :0.10434
## 3rd Qu.:104.10 3rd Qu.: 782.7 3rd Qu.:0.10530 3rd Qu.:0.13040
## Max. :188.50 Max. :2501.0 Max. :0.16340 Max. :0.34540
## concavity_mean concave_points_mean symmetry_mean fractal_dimension_mean
## Min. :0.00000 Min. :0.00000 Min. :0.1060 Min. :0.04996
## 1st Qu.:0.02956 1st Qu.:0.02031 1st Qu.:0.1619 1st Qu.:0.05770
## Median :0.06154 Median :0.03350 Median :0.1792 Median :0.06154
## Mean :0.08880 Mean :0.04892 Mean :0.1812 Mean :0.06280
## 3rd Qu.:0.13070 3rd Qu.:0.07400 3rd Qu.:0.1957 3rd Qu.:0.06612
## Max. :0.42680 Max. :0.20120 Max. :0.3040 Max. :0.09744
## radius_SE texture_SE perimeter_SE area_SE
## Min. :0.1115 Min. :0.3602 Min. : 0.757 Min. : 6.802
## 1st Qu.:0.2324 1st Qu.:0.8339 1st Qu.: 1.606 1st Qu.: 17.850
## Median :0.3242 Median :1.1080 Median : 2.287 Median : 24.530
## Mean :0.4052 Mean :1.2169 Mean : 2.866 Mean : 40.337
## 3rd Qu.:0.4789 3rd Qu.:1.4740 3rd Qu.: 3.357 3rd Qu.: 45.190
## Max. :2.8730 Max. :4.8850 Max. :21.980 Max. :542.200
## smoothness_SE compactness_SE concavity_SE concave_points_SE
## Min. :0.001713 Min. :0.002252 Min. :0.00000 Min. :0.000000
## 1st Qu.:0.005169 1st Qu.:0.013080 1st Qu.:0.01509 1st Qu.:0.007638
## Median :0.006380 Median :0.020450 Median :0.02589 Median :0.010930
## Mean :0.007041 Mean :0.025478 Mean :0.03189 Mean :0.011796
## 3rd Qu.:0.008146 3rd Qu.:0.032450 3rd Qu.:0.04205 3rd Qu.:0.014710
## Max. :0.031130 Max. :0.135400 Max. :0.39600 Max. :0.052790
## symmetry_SE fractal_dimension_SE radius_worst texture_worst
## Min. :0.007882 Min. :0.0008948 Min. : 7.93 Min. :12.02
## 1st Qu.:0.015160 1st Qu.:0.0022480 1st Qu.:13.01 1st Qu.:21.08
## Median :0.018730 Median :0.0031870 Median :14.97 Median :25.41
## Mean :0.020542 Mean :0.0037949 Mean :16.27 Mean :25.68
## 3rd Qu.:0.023480 3rd Qu.:0.0045580 3rd Qu.:18.79 3rd Qu.:29.72
## Max. :0.078950 Max. :0.0298400 Max. :36.04 Max. :49.54
## perimeter_worst area_worst smoothness_worst compactness_worst
## Min. : 50.41 Min. : 185.2 Min. :0.07117 Min. :0.02729
## 1st Qu.: 84.11 1st Qu.: 515.3 1st Qu.:0.11660 1st Qu.:0.14720
## Median : 97.66 Median : 686.5 Median :0.13130 Median :0.21190
## Mean :107.26 Mean : 880.6 Mean :0.13237 Mean :0.25427
## 3rd Qu.:125.40 3rd Qu.:1084.0 3rd Qu.:0.14600 3rd Qu.:0.33910
## Max. :251.20 Max. :4254.0 Max. :0.22260 Max. :1.05800
## concavity_worst concave_points_worst symmetry_worst fractal_dimension_worst
## Min. :0.0000 Min. :0.00000 Min. :0.1565 Min. :0.05504
## 1st Qu.:0.1145 1st Qu.:0.06493 1st Qu.:0.2504 1st Qu.:0.07146
## Median :0.2267 Median :0.09993 Median :0.2822 Median :0.08004
## Mean :0.2722 Mean :0.11461 Mean :0.2901 Mean :0.08395
## 3rd Qu.:0.3829 3rd Qu.:0.16140 3rd Qu.:0.3179 3rd Qu.:0.09208
## Max. :1.2520 Max. :0.29100 Max. :0.6638 Max. :0.20750Enfin, la matrice de corrélation nous permet d’observer les corrélations entre nos variables.
Les valeurs élevées et basses dans le contexte de la corrélation indiquent la force et la direction de la relation linéaire entre deux variables. Voici ce que signifient les valeurs élevées et basses de corrélation :
Valeurs élevées de corrélation positive : Une valeur élevée de corrélation positive (proche de +1) indique une relation linéaire forte et positive entre les deux variables. Cela signifie que lorsque la valeur d’une variable augmente, la valeur de l’autre variable augmente également.
Valeurs élevées de corrélation négative : Une valeur élevée de corrélation négative (proche de -1) indique une relation linéaire forte et négative entre les deux variables. Cela signifie que lorsque la valeur d’une variable augmente, la valeur de l’autre variable diminue.
Valeurs proches de zéro ou faibles de corrélation : Des valeurs proches de zéro ou faibles de corrélation (proches de 0) indiquent une faible relation linéaire entre les variables. Cela suggère qu’il y a peu ou pas de lien linéaire entre les variables étudiées. Une corrélation faible signifie que les valeurs des variables ne varient pas de manière linéairement prévisible.
data_noDiagnosis <- subset(clean_data, select = -Diagnosis)
cor_matrix <- cor(data_noDiagnosis)
# Afficher la matrice de corrélation
cor_matrix_melted <- melt(cor_matrix)
ggplot(data = cor_matrix_melted, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
scale_fill_gradient(low = "blue", high = "red") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Matrice de corrélation",
x = "Variable 1", y = "Variable 2",
caption = "Basé sur le dataset wdbc.data")
Question n°2
1 - Analyse descriptive du jeu de donnée par clustering K-means
Pour réaliser cette analyse descriptive, nous allons réaliser une analyse par clustering en utilisant la méthode des k plus proches voisins.
Dans un premier temps, il est alors nécessaire de charger et de nettoyer le jeu de données en renommant les variables et en éliminant les données manquantes. Il est aussi nécessaire de renommer les différentes variables présentes dans le dataset. Ainsi, les variables se terminant par _mean réfèrent à la moyenne de celle-ci, les variables se terminant par _SE indiquent la Mean Squared Error et celle terminant par _worst indiquent la pire évaluation.
km_dataset <- data %>%
drop_na()Le paramétrage de la seed ci-dessous permet d’obtenir une reproductibilité dans les résultats obtenus lors des entraînements de modèles.
set.seed(123)Par choix, nous allons choisir de nous concentrer sur les variables terminant par _mean afin d’obtenir une certaine constance dans les résultats et leurs interprétabilité.
Dans le but de déterminer le nombre optimal de clusters, nous allons utiliser l’Elbow method qui consiste à tracer la somme des carrés des distances intracluster (WCSS) en fonction du nombre de clusters et à rechercher le point où la courbe forme un “coude” ou un changement de direction brusque.
Ainsi dans la courbe obtenue ci-dessous, on peut observer que la cassure a lieu pour 2 clusters. Voici donc notre nombre optimal de clusters.
# Fancy K-Means
fviz_nbclust(scale(km_dataset[,3:12]), kmeans, nstart=100, method = "wss") +
geom_vline(xintercept = 2, linetype = 1)
La méthode utilisée ici est que le modèle va créer une dataset clone de celui initial et va y ajouter une variable supplémentaire nommée ‘Cluster’ et pour chaque ligne y indiquer dans quels clusters elle se trouve.
kmeans_basic <- kmeans(km_dataset[,3:12], centers = 2)
kmeans_basic_table <- data.frame(kmeans_basic$size, kmeans_basic$centers)
kmeans_basic_df <- data.frame(Cluster = kmeans_basic$cluster, km_dataset)
kable(kmeans_basic_df[1:6, 1:7],
format = "latex",
booktabs = T)On peut alors représenter les deux clusters créés puis y indiquer en leurs seins s’il s’agit du diagnostic bénin (B) ou alors malin (M).
Dans ce graphique, on peut alors observer que le cluster 2 est quasiment totalement constitué de patients dont la tumeur a été diagnostiquée comme maligne tandis que pour le cluster 1, on peut remarquer qu’il y a une nette disparité dans la composition du cluster.
# Example ggplot
ggplot(data = kmeans_basic_df, aes(x = Cluster)) +
geom_bar(aes(fill = Diagnosis)) +
ggtitle("Count of Clusters by Diagnosis") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_fill_brewer(palette = "Set1")
On peut aussi observer ci-dessous la représentation graphique des deux clusters obtenus.
fviz_cluster(kmeans_basic, data = scale(km_dataset[,3:12]), geom = c("point"),ellipse.type = "euclid")
Dans cette seconde partie de la génération du modèle de clustering par k-mean, nous allons essayer d’améliorer le modèle que nous avions précédemment obtenu. Pour cela, nous allons augmenter le nombre d’essais de génération du clustering en passant à 100 le nombre de positions aléatoire de départ du K.
# Fancy kmeans
set.seed(123)
kmeans_fancy <- kmeans(scale(km_dataset[,3:12]), 2, nstart = 100)
kmeans_fancy_df <- data.frame(Cluster = kmeans_fancy$cluster, km_dataset)
# plot the clusters
fviz_cluster(kmeans_fancy, data = scale(km_dataset[,3:12]), geom = c("point"),ellipse.type = "euclid")
On observe pour ce nouveau modèle qu’un des clusters reste majoritairement composé de patients dont la tumeur est maligne tandis que pour le second cluster, la proportion de patient dont la tumeur est maligne diminue comparé au précédent modèle. On peut alors en conclure que le second modèle est plus précis pour partitionner les deux classes de patients.
ggplot(data = kmeans_fancy_df, aes(x = Cluster)) +
geom_bar(aes(fill = Diagnosis)) +
ggtitle("Count of Clusters by Diagnosis") +
theme(plot.title = element_text(hjust = 0.5)) +
scale_fill_brewer(palette = "Set1")
Enfin, dans le tableau ci-dessous, nous réalisons une étude statistique de la composition des clusters.
outCtl <- tableby(Cluster ~ Diagnosis + radius_mean + texture_mean +
perimeter_mean + area_mean + smoothness_mean +
compactness_mean + concavity_mean + concave_points_mean +
symmetry_mean + fractal_dimension_mean,
data=kmeans_fancy_df,
control=tableby.control(total=T, cat.simplify=F,
numeric.stats = c("Nmiss", "meansd", "range"),digits=1))
summary(outCtl, text=F)| 1 (N=169) | 2 (N=400) | Total (N=569) | p value | |
|---|---|---|---|---|
| Diagnosis | < 0.001 | |||
| B | 6 (3.6%) | 351 (87.8%) | 357 (62.7%) | |
| M | 163 (96.4%) | 49 (12.2%) | 212 (37.3%) | |
| radius_mean | < 0.001 | |||
| Mean (SD) | 18.1 (3.2) | 12.5 (2.0) | 14.1 (3.5) | |
| Range | 9.3 - 28.1 | 7.0 - 18.8 | 7.0 - 28.1 | |
| texture_mean | < 0.001 | |||
| Mean (SD) | 21.5 (4.1) | 18.4 (4.0) | 19.3 (4.3) | |
| Range | 10.4 - 39.3 | 9.7 - 33.8 | 9.7 - 39.3 | |
| perimeter_mean | < 0.001 | |||
| Mean (SD) | 119.9 (21.8) | 80.2 (13.0) | 92.0 (24.3) | |
| Range | 61.5 - 188.5 | 43.8 - 120.9 | 43.8 - 188.5 | |
| area_mean | < 0.001 | |||
| Mean (SD) | 1045.6 (377.1) | 489.8 (156.4) | 654.9 (351.9) | |
| Range | 248.7 - 2501.0 | 143.5 - 1102.0 | 143.5 - 2501.0 | |
| smoothness_mean | < 0.001 | |||
| Mean (SD) | 0.1 (0.0) | 0.1 (0.0) | 0.1 (0.0) | |
| Range | 0.1 - 0.2 | 0.1 - 0.1 | 0.1 - 0.2 | |
| compactness_mean | < 0.001 | |||
| Mean (SD) | 0.2 (0.1) | 0.1 (0.0) | 0.1 (0.1) | |
| Range | 0.1 - 0.3 | 0.0 - 0.2 | 0.0 - 0.3 | |
| concavity_mean | < 0.001 | |||
| Mean (SD) | 0.2 (0.1) | 0.0 (0.0) | 0.1 (0.1) | |
| Range | 0.1 - 0.4 | 0.0 - 0.3 | 0.0 - 0.4 | |
| concave_points_mean | < 0.001 | |||
| Mean (SD) | 0.1 (0.0) | 0.0 (0.0) | 0.0 (0.0) | |
| Range | 0.1 - 0.2 | 0.0 - 0.1 | 0.0 - 0.2 | |
| symmetry_mean | < 0.001 | |||
| Mean (SD) | 0.2 (0.0) | 0.2 (0.0) | 0.2 (0.0) | |
| Range | 0.1 - 0.3 | 0.1 - 0.3 | 0.1 - 0.3 | |
| fractal_dimension_mean | 0.006 | |||
| Mean (SD) | 0.1 (0.0) | 0.1 (0.0) | 0.1 (0.0) | |
| Range | 0.1 - 0.1 | 0.0 - 0.1 | 0.0 - 0.1 |
2 - Analyse descriptive du jeu de donnée par clustering Classification ascendante hiérarchique
wdbc <- read_csv("wdbc.data",
col_names = c("ID number",
"Diagnosis",
"radius_mean",
"texture_mean",
"perimeter_mean",
"area_mean","smoothness_mean",
"compactness_mean",
"concavity_mean",
"concave_points_mean",
"symmetry_mean",
"fractal_dimension_mean",
"radius_SE","texture_SE",
"perimeter_SE","area_SE",
"smoothness_SE",
"compactness_SE",
"concavity_SE",
"concave_points_SE",
"symmetry_SE",
"fractal_dimension_SE",
"radius_worst",
"texture_worst",
"perimeter_worst",
"area_worst",
"smoothness_worst",
"compactness_worst",
"concavity_worst",
"concave_points_worst",
"symmetry_worst",
"fractal_dimension_worst"))## Rows: 569 Columns: 32
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Diagnosis
## dbl (31): ID number, radius_mean, texture_mean, perimeter_mean, area_mean, s...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Nous sélectionnons les variables qui nous interessent, ici tous les variables _mean, et faisons une standardisation. Nous faisons ensuite un calcul de la matrice de distances entre les individus en utilisant la méthode de calcul euclidienne.
# Sélection des variables et standardisation
myvars <- wdbc[,c("radius_mean", "texture_mean", "perimeter_mean","area_mean","smoothness_mean","compactness_mean","concavity_mean","concave_points_mean","symmetry_mean","fractal_dimension_mean")]
myvars <- scale(myvars)
# Calcul de la matrice de distances
mydist <- dist(myvars, method = "euclidean")
head(mydist)## [1] 7.082678 4.791658 5.245540 5.210302 4.610234 6.436641Nous effectuons maintenant la classification ascendante hiérarchique en utilisant la méthode de Ward.Nous obtenons ainsi un dendrogramme représentant la classification obtenue.
# Classification ascendante hiérarchique
myhclust <- hclust(mydist, method = "ward.D2")
# Visualisation du dendrogramme
plot(myhclust, labels = FALSE)
Nous allons utiliser des visualisations pour interpréter les résultats de l’analyse de clustering et prendre des décisions concernant le nombre de classes à retenir. Nous pouvons voir que nous observons qu’il est possible de définir 2 ou 3 classes suite à la classification.
inertie <- sort(myhclust$height, decreasing = TRUE)
plot(inertie[1:20], type = "s", xlab = "Nombre de classes", ylab = "Inertie")
points(c(2, 3), inertie[c(2, 3)], col = c("green3", "red3"), cex = 2, lwd = 3)
plot(myhclust, labels = FALSE, main = "Partition en 2 ou 3 classes", xlab = "", ylab = "", sub = "", axes = FALSE, hang = -1)
rect.hclust(myhclust, 2, border = "green3")
rect.hclust(myhclust, 3, border = "red3")
fviz_dend(myhclust, k = 2, show_labels = FALSE, rect = TRUE)
fviz_dend(myhclust, k = 3, show_labels = FALSE, rect = TRUE)
Nous utilisons une fonction nous permettant de déterminer la meilleure coupe du dendrogramme.Nous obtenons comme résultat que le nombre de classes optimal est 3.
best.cutree(myhclust)## [1] 3best.cutree(myhclust, graph = TRUE, xlab = "Nombre de classes", ylab = "Inertie relative")
## [1] 3typo <- cutree(myhclust, 3)
freq(typo)##
##
## **Frequency table**
##
## Class: integer (numeric)
## Length: 569
## Available: 569 (100%, NA: 0 = 0%)
## Unique: 3
##
## Mean: 2.41
## SD: 0.82 (CV: 0.34, MAD: 0)
## Five-Num: 1 | 2 | 3 | 3 | 3 (IQR: 1, CQV: 0.2)
## Outliers: 0 (0%)
##
##
## | | Item| Count| Percent| Cum. Count| Cum. Percent|
## |:--|-----:|------:|--------:|-----------:|-------------:|
## |1 | 3| 352| 61.86%| 352| 61.86%|
## |2 | 1| 120| 21.09%| 472| 82.95%|
## |3 | 2| 97| 17.05%| 569| 100.00%|Nous prenons donc comme valeur k= 3 et ajoutons une variable supplémentaire nommée ‘Cluster’ et pour chaque ligne y indiquer dans quels clusters elle se trouve.
# Détermination du nombre de groupes à former
mycut <- cutree(myhclust, k = 3)
# Attribution des individus aux groupes correspondants
wdbc$Cluster <- mycut
hc.cut <- hcut(myvars, k= 3, hc_method = "complete")
fviz_cluster(hc.cut, ellipse.type = "convex")
Nous utilisons l’indice de Rand ajusté, pour évaluer objectivement la qualité de notre clustering en le comparant aux véritables classes des données. Cela nous permet de mesurer à quel point les groupes obtenus correspondent aux structures réelles des données.Nous obtenons Une valeur de 0,47, qui indique une concordance relativement faible entre les partitions du clustering et les étiquettes de classes.
rst <- adjustedRandIndex(mycut, wdbc$Diagnosis)
rst## [1] 0.4698196Question 3
Nous allons ensuite développer différents modèles de diagnostic et en évaluer leurs performances. Trois approches vont être utilisées : une méthode par Arbre de décision, une par Forêts aléatoires et une par Ensemble Learning.
1 - Méthode par Arbre de décision
Pour cette méthode par Arbre de décision, nous allons commencer par charger une dataset clone des données que nous souhaitons analyser. Nous allons ensuite partitionner ce dataset en deux parties : une qui servira de base de données d’entrainement du modèle, et une qui nous permettra d’évaluer le modèle obtenu précédemment.
library(tidyverse)
library(FactoMineR)
library(factoextra)
library(rpart)
library(rpart.plot)
library(caret)
dt_dataset <- clean_data
nb_lignes <- floor((nrow(dt_dataset)*0.75)) #Nombre de lignes de l’échantillon d’apprentissage : 75% du dataset
dt_dataset <- dt_dataset[sample(nrow(dt_dataset)), ] #Ajout de numéros de lignes
dt_dataset.train <- dt_dataset[1:nb_lignes, ] #Echantillon d’apprentissage
dt_dataset.test <- dt_dataset[(nb_lignes+1):nrow(dt_dataset), ] #Echantillon de testVoici ci-dessous les résultats du modèle entraîné sur le dataset d’entraînement. Cet arbre de décision est volumineux et va donc avoir besoin d’un élagage afin de réduire sa complexité. Pour cela, nous allons faire appel à la formule du coût de complexité. Il s’agit d’un paramètre qui permet de contrôler la taille maximale de l’arbre de décision, c’est-à-dire le nombre maximal de nœuds ou de feuilles dans l’arbre.
En général, un arbre de décision plus complexe peut mieux s’adapter aux données d’entraînement, mais il est également plus susceptible de surapprendre (overfitting) et de mal généraliser aux nouvelles données. Par conséquent, le coût de complexité est souvent utilisé pour éviter le surapprentissage en régularisant le modèle et en limitant sa complexité.
set.seed(12)
#Construction de l’arbre
dataset.Tree <- rpart(Diagnosis ~ .,
data = dt_dataset.train,
method = "class",
control = rpart.control(minsplit = 5, cp=0))
#Affichage du résultat
rpart.plot(dataset.Tree)
Pour bien élaguer notre arbre de décision, nous allons chercher le coût de complexité (cp) pour lequel le taux de mauvais classement (xerror) est la plus faible.
#On cherche à minimiser l’erreur pour définir le niveau d’élagage
#plotcp(dataset.Tree)
printcp(dataset.Tree)##
## Classification tree:
## rpart(formula = Diagnosis ~ ., data = dt_dataset.train, method = "class",
## control = rpart.control(minsplit = 5, cp = 0))
##
## Variables actually used in tree construction:
## [1] area_mean concave_points_mean concavity_mean
## [4] perimeter_mean radius_mean smoothness_mean
## [7] texture_mean
##
## Root node error: 166/426 = 0.38967
##
## n= 426
##
## CP nsplit rel error xerror xstd
## 1 0.7951807 0 1.000000 1.00000 0.060636
## 2 0.0361446 1 0.204819 0.22289 0.035016
## 3 0.0301205 2 0.168675 0.25301 0.037066
## 4 0.0180723 3 0.138554 0.24096 0.036267
## 5 0.0090361 5 0.102410 0.18072 0.031812
## 6 0.0060241 7 0.084337 0.17470 0.031317
## 7 0.0000000 15 0.036145 0.18675 0.032297Le coût de complexité optimal pour ce modèle va s’afficher sous ce paragraphe. Ce paramètre va ensuite être utilisé pour élaguer l’arbre obtenu précédemment.
print(dataset.Tree$cptable[which.min(dataset.Tree$cptable[,4]),1])## [1] 0.006024096Voici donc ci-dessous le résultat de l’élagage de l’arbre de décision. Ce nouvel arbre est plus court et donc, plus généraliste et aura par conséquence moins tendance à overfitter.
set.seed(12)
#Elagage de l’arbre avec le cp optimal
dataset.Tree_Opt <- prune(dataset.Tree,
cp = dataset.Tree$cptable[which.min(dataset.Tree$cptable[,4]),1])
#Représentation graphique de l’arbre optimal
rpart.plot(dataset.Tree_Opt)
Enfin, nous avons entrainé le modèle obtenu sur le dataset de test que nous avions précédemment créé. Ensuite, nous avons réalisé plusieurs tests statistiques sur les prédictions qu’il a pu faire.
Les résultats de l’arbre de décision montrent une performance globalement élevée, avec une précision (accuracy) de 91,61%. On peut être satisfait de la capacité du modèle à discriminer entre les classes, avec une sensibilité de 84% pour la classe positive (M) et une spécificité de 95,7% pour la classe négative (B). Le coefficient Kappa de 0,812 indique un accord significatif entre les prédictions du modèle et les valeurs réelles. Ces résultats me donnent confiance dans la compétence du modèle à effectuer des prédictions précises.
#Prédiction du modèle sur les données de test
dataset.test_Predict<-predict(dataset.Tree_Opt,newdata=dt_dataset.test, type= "class")
dt_dataset.test$Diagnosis <- factor(dt_dataset.test$Diagnosis, levels = c("B", "M"))
#Création d'un tableau de confusion
confusionMatrix(dt_dataset.test$Diagnosis, dataset.test_Predict, positive = "M")## Confusion Matrix and Statistics
##
## Reference
## Prediction B M
## B 89 8
## M 4 42
##
## Accuracy : 0.9161
## 95% CI : (0.858, 0.9559)
## No Information Rate : 0.6503
## P-Value [Acc > NIR] : 1.266e-13
##
## Kappa : 0.812
##
## Mcnemar's Test P-Value : 0.3865
##
## Sensitivity : 0.8400
## Specificity : 0.9570
## Pos Pred Value : 0.9130
## Neg Pred Value : 0.9175
## Prevalence : 0.3497
## Detection Rate : 0.2937
## Detection Prevalence : 0.3217
## Balanced Accuracy : 0.8985
##
## 'Positive' Class : M
## 2 - Méthode par Forets aléatoires
Pour cette méthode par Forêts aléatoires (Random forests), il est nécessaire de partitionner notre dataset initial en deux sections : une d’entraînement et une de test.
# Diviser les données en ensembles d'apprentissage et de test
set.seed(123) # pour la reproductibilité des résultats
train_index <- sample(nrow(rf_dataset), 0.7 * nrow(rf_dataset))
train_data <- rf_dataset[train_index, ]
test_data <- rf_dataset[-train_index, ]Nous allons ensuite entrainer le modèle de Random forests.
# Entraîner le modèle de forêt aléatoire
rf_model <- randomForest(Diagnosis ~ ., data = train_data, ntree = 100, mtry = 2, na.action = na.omit)
# Afficher les résultats du modèle
print(rf_model)##
## Call:
## randomForest(formula = Diagnosis ~ ., data = train_data, ntree = 100, mtry = 2, na.action = na.omit)
## Type of random forest: classification
## Number of trees: 100
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 6.03%
## Confusion matrix:
## B M class.error
## B 249 10 0.03861004
## M 14 125 0.10071942Puis faire en sorte d’afficher les variables que le modèle considère comme importantes et indiquer par un score si elles sont plus ou moins importantes.
Les variables les plus importantes sont celles qui ont les valeurs les plus élevées de “MeanDecreaseGini”. Dans notre cas, les variables les plus importantes sont “concave_points_mean” avec une valeur de 38.963054, suivie par “area_mean” avec 27.354739 et “perimeter_mean” avec 25.170804.
Les variables ayant des valeurs relativement faibles de “MeanDecreaseGini” sont considérées comme moins importantes pour la prédiction dans ce modèle. Ici, les variables “symmetry_mean” et “fractal_dimension_mean” ont les valeurs les plus faibles avec 3.806719 et 4.201104 respectivement et présentent donc l’importance la plus faible.
# Calculer l'importance des variables
var_importance <- importance(rf_model)
# Afficher les variables les plus importantes
print(var_importance)## MeanDecreaseGini
## radius_mean 24.858775
## texture_mean 11.107298
## perimeter_mean 25.170804
## area_mean 27.354739
## smoothness_mean 6.419145
## compactness_mean 11.717715
## concavity_mean 26.848889
## concave_points_mean 38.963054
## symmetry_mean 3.806719
## fractal_dimension_mean 4.201104Enfin nous allons soumettre notre modèle au dataset de test afin qu’il puissent réaliser ses prédictions. Ses résultats seront analysés grace à différents tests statistiques.
En résumé, notre modèle Random Forest semble présenter de bons résultats avec une précision globale de 91,81%. Il démontre une sensibilité élevée (94,03%) et une bonne spécificité (90,38%). Le coefficient Kappa de 0,8309 indique un accord entre les prédictions du modèle et les étiquettes réelles.
# Évaluer la performance du modèle sur les données de test
rf_predictions <- predict(rf_model, test_data)
confusionMatrix(test_data$Diagnosis, rf_predictions, positive = "M")## Confusion Matrix and Statistics
##
## Reference
## Prediction B M
## B 94 4
## M 10 63
##
## Accuracy : 0.9181
## 95% CI : (0.8664, 0.9545)
## No Information Rate : 0.6082
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.8309
##
## Mcnemar's Test P-Value : 0.1814
##
## Sensitivity : 0.9403
## Specificity : 0.9038
## Pos Pred Value : 0.8630
## Neg Pred Value : 0.9592
## Prevalence : 0.3918
## Detection Rate : 0.3684
## Detection Prevalence : 0.4269
## Balanced Accuracy : 0.9221
##
## 'Positive' Class : M
## 3 - Méthode par Ensemble Learning
Pour cette méthode par Ensemble Learning, nous allons utiliser 3 techniques différentes afin d’agréger les différents algorithmes qui seront utilisés. Nous exploiterons dans un premier temps un algorithme de Boosting, puis de Bagging et enfin de Stacking.
Les algorithmes par Boosting font en sorte que construire plusieurs modèles qui vont fixer les erreurs de prédictions du précédent modèle dans la chaine. Ceux par Bagging vont construire différents modèles sur différentes partitions du dataset initial. Enfin ceux par Stacking construisent différents modèles et un modèle de supervision qui va apprendre comment combiner ces modèles primaires.
Ainsi ci-dessous, nous allons agréger un algorithme nommé C5.0 et un algorithme appelé Stochastic Gradient Boosting (GBM). Les résultats affichés ci-dessous indiquent que le GBM est légèrement supérieur au C5.0 avec une précision (Accuracy) de 95.07% contre 95.01% et un Kappa (score permettant d’évaluer la performance d’un modèle) de 89.41% contre 89.32%.
# Example of Boosting Algorithms
control <- trainControl(method="repeatedcv", number=10, repeats=3)
seed <- 7
metric <- "Accuracy"
# C5.0
set.seed(seed)
fit.c50 <- train(Diagnosis~., data=clean_data, method="C5.0", metric=metric, trControl=control)
# Stochastic Gradient Boosting
set.seed(seed)
fit.gbm <- train(Diagnosis~., data=clean_data, method="gbm", metric=metric, trControl=control, verbose=FALSE)
# summarize results
boosting_results <- resamples(list(c5.0=fit.c50, gbm=fit.gbm))
summary(boosting_results)##
## Call:
## summary.resamples(object = boosting_results)
##
## Models: c5.0, gbm
## Number of resamples: 30
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## c5.0 0.9107143 0.9174877 0.9473684 0.9501217 0.9824561 1 0
## gbm 0.8928571 0.9298246 0.9482759 0.9507476 0.9778352 1 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## c5.0 0.8076923 0.8231128 0.8880157 0.8932379 0.9619238 1 0
## gbm 0.7714286 0.8480159 0.8891720 0.8941705 0.9524623 1 0dotplot(boosting_results)
Ensuite, dans le cadre des algorithmes de Bagging, nous allons utiliser deux algorithmes différents : le Bagged CART et les Forêts aléatoires (Random forests). Les résultats obtenus indiquent que le modèle basé sur le Random forests est supérieur au Bagged CART avec une précision de 94.31% contre 94.01% et un Kappa de 87.85% contre 87.21%.
# Example of Bagging algorithms
control <- trainControl(method="repeatedcv", number=10, repeats=3)
seed <- 7
metric <- "Accuracy"
# Bagged CART
set.seed(seed)
fit.treebag <- train(Diagnosis~., data=clean_data, method="treebag", metric=metric, trControl=control)
# Random Forest
set.seed(seed)
fit.rf <- train(Diagnosis~., data=clean_data, method="rf", metric=metric, trControl=control)
# summarize results
bagging_results <- resamples(list(treebag=fit.treebag, rf=fit.rf))
summary(bagging_results)##
## Call:
## summary.resamples(object = bagging_results)
##
## Models: treebag, rf
## Number of resamples: 30
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## treebag 0.862069 0.9163534 0.9473684 0.9401679 0.9649123 1 0
## rf 0.862069 0.9285714 0.9385965 0.9431333 0.9653660 1 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## treebag 0.7121588 0.8211847 0.8857715 0.8721974 0.9246779 1 0
## rf 0.7121588 0.8453999 0.8700779 0.8785620 0.9265933 1 0dotplot(bagging_results)
Pour la méthode par Stacking, nous utilisons 5 algorithmes : Linear Discriminate Analysis (LDA), Classification and Regression Trees (CART), la Régression logistique, les K plus proches voisins et Support Vector Machine with a Radial Basis Kernel Function (SVM).
Les résultats indiquent que le SVM produit le modèle le plus précis avec une précision de 95.02% et un Kappa de 89.22%.
# Example of Stacking algorithms
# create submodels
control <- trainControl(method="repeatedcv", number=10, repeats=3, savePredictions=TRUE, classProbs=TRUE)
algorithmList <- c('lda', 'rpart', 'glm', 'knn', 'svmRadial')
set.seed(seed)
models <- caretList(Diagnosis~., data=clean_data, trControl=control, methodList=algorithmList)
results <- resamples(models)
summary(results)##
## Call:
## summary.resamples(object = results)
##
## Models: lda, rpart, glm, knn, svmRadial
## Number of resamples: 30
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## lda 0.8571429 0.9122807 0.9304295 0.9344115 0.9647556 1.0000000 0
## rpart 0.8421053 0.8947368 0.9130369 0.9151114 0.9425800 0.9649123 0
## glm 0.8596491 0.9122807 0.9468985 0.9337654 0.9482759 0.9824561 0
## knn 0.7719298 0.8750000 0.8947368 0.8904431 0.9134150 0.9649123 0
## svmRadial 0.8448276 0.9339756 0.9562808 0.9502229 0.9778352 1.0000000 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## lda 0.6767677 0.8078828 0.8471607 0.8560612 0.9228902 1.0000000 0
## rpart 0.6614786 0.7742824 0.8126460 0.8189212 0.8756117 0.9260700 0
## glm 0.6984127 0.8123184 0.8857715 0.8574269 0.8891720 0.9626719 0
## knn 0.4618736 0.7231262 0.7668468 0.7576957 0.8148049 0.9246032 0
## svmRadial 0.6675159 0.8557692 0.9057510 0.8922843 0.9526714 1.0000000 0dotplot(results)
On peut observer, avant de stacker les modèles, que LDA présente de fortes corrélations avec GLM (0.8 de corrélation avec un seuil significatif à 0.75) et avec SVM (0.77 de corrélations).
# correlation between results
modelCor(results)## lda rpart glm knn svmRadial
## lda 1.0000000 0.6352583 0.8028110 0.4247722 0.7764634
## rpart 0.6352583 1.0000000 0.5923717 0.4254711 0.6501977
## glm 0.8028110 0.5923717 1.0000000 0.5633917 0.6297564
## knn 0.4247722 0.4254711 0.5633917 1.0000000 0.4808792
## svmRadial 0.7764634 0.6501977 0.6297564 0.4808792 1.0000000splom(results)
Étant donné les trop fortes corrélations avec ces trois algorithmes, nous allons donc exclure LDA afin d’éviter de fausser notre modèle par Stacking. On peut alors observer que par ce Stacking par GLM, notre précision a diminué de 95.02% à 94.49% et le Kappa a de même diminué de 89.22% à 88.15%.
La conclusion de cette technique de Stacking par GLM est donc que notre modèle par SVM apportait de meilleures performances sans Stacking.
# stack using glm
new_algorithmList <- c('glm', 'rpart', 'knn', 'svmRadial')
new_models <- caretList(Diagnosis~., data=clean_data, trControl=control, methodList=new_algorithmList)
stackControl <- trainControl(method="repeatedcv", number=10, repeats=3, savePredictions=TRUE, classProbs=TRUE)
set.seed(seed)
stack.glm <- caretStack(new_models, method="glm", metric="Accuracy", trControl=stackControl)
print(stack.glm)## A glm ensemble of 4 base models: glm, rpart, knn, svmRadial
##
## Ensemble results:
## Generalized Linear Model
##
## 1707 samples
## 4 predictor
## 2 classes: 'B', 'M'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 1537, 1536, 1536, 1536, 1535, 1537, ...
## Resampling results:
##
## Accuracy Kappa
## 0.9449211 0.8815106Tandis que pour le Stacking par Random Forests, notre précision augmente en passant à 96.21% et le Kappa augmente aussi pour atteindre 91.82%.
On peut donc affirmer que le Stacking par Random Forests apporte les meilleures performances de modèles par Ensemble Learning.
# stack using random forest
set.seed(seed)
stack.rf <- caretStack(new_models, method="rf", metric="Accuracy", trControl=stackControl)
print(stack.rf)## A rf ensemble of 4 base models: glm, rpart, knn, svmRadial
##
## Ensemble results:
## Random Forest
##
## 1707 samples
## 4 predictor
## 2 classes: 'B', 'M'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 1537, 1536, 1536, 1536, 1535, 1537, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.9621016 0.9182071
## 3 0.9619044 0.9178726
## 4 0.9599528 0.9136868
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.Partie II
Nous avons choisi comme de notre choix un dataset sur le diabète et nous avons fais le choix de choisir une approche supervisée d’arbre de décision. Dataset : https://www.kaggle.com/datasets/iammustafatz/diabetes-prediction-dataset?resource=download&fbclid=IwAR1F9jDfOzNJTqTne1SHU1kka85rcS9atS6BihGSZFTxHp80T2t9Egps5YU
Nous commencons par nettoyer notre dataset et vérifier que nos variables sont bien définies sous la bonne catégorie de variables : ici factoriser 6 de nos variables.
diabetes_prediction_dataset <- read_csv("diabetes_prediction_dataset.csv")
diabetes_prediction_dataset$gender[diabetes_prediction_dataset$gender == "Other"] <- NA
diabetes_prediction_dataset$smoking_history[diabetes_prediction_dataset$smoking_history == "No Info"] <- NAglimpse(diabetes_prediction_dataset)## Rows: 100,000
## Columns: 9
## $ gender <chr> "Female", "Female", "Male", "Female", "Male", "Fem…
## $ age <dbl> 80, 54, 28, 36, 76, 20, 44, 79, 42, 32, 53, 54, 78…
## $ hypertension <dbl> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ heart_disease <dbl> 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ smoking_history <chr> "never", NA, "never", "current", "current", "never…
## $ bmi <dbl> 25.19, 27.32, 27.32, 23.45, 20.14, 27.32, 19.31, 2…
## $ HbA1c_level <dbl> 6.6, 6.6, 5.7, 5.0, 4.8, 6.6, 6.5, 5.7, 4.8, 5.0, …
## $ blood_glucose_level <dbl> 140, 80, 158, 155, 155, 85, 200, 85, 145, 100, 85,…
## $ diabetes <dbl> 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…diabetes_prediction_dataset$gender <- as.factor(diabetes_prediction_dataset$gender)
diabetes_prediction_dataset$hypertension <- as.factor(diabetes_prediction_dataset$hypertension)
diabetes_prediction_dataset$heart_disease <- as.factor(diabetes_prediction_dataset$heart_disease)
diabetes_prediction_dataset$heart_disease <- as.factor(diabetes_prediction_dataset$heart_disease)
diabetes_prediction_dataset$smoking_history <- as.factor(diabetes_prediction_dataset$smoking_history)
diabetes_prediction_dataset$diabetes <- as.factor(diabetes_prediction_dataset$diabetes)
summary(diabetes_prediction_dataset)## gender age hypertension heart_disease smoking_history
## Female:58552 Min. : 0.08 0:92515 0:96058 current : 9286
## Male :41430 1st Qu.:24.00 1: 7485 1: 3942 ever : 4004
## NA's : 18 Median :43.00 former : 9352
## Mean :41.89 never :35095
## 3rd Qu.:60.00 not current: 6447
## Max. :80.00 NA's :35816
## bmi HbA1c_level blood_glucose_level diabetes
## Min. :10.01 Min. :3.500 Min. : 80.0 0:91500
## 1st Qu.:23.63 1st Qu.:4.800 1st Qu.:100.0 1: 8500
## Median :27.32 Median :5.800 Median :140.0
## Mean :27.32 Mean :5.528 Mean :138.1
## 3rd Qu.:29.58 3rd Qu.:6.200 3rd Qu.:159.0
## Max. :95.69 Max. :9.000 Max. :300.0Pour cette méthode par Arbre de décision, nous allons partionner ce dataset en deux parties : une qui servira de base de données d’entrainement du modèle, et une qui nous permettra d’évaluer le modèle obtenu précédemment.
#Création d’un dataset d’apprentissage et d’un dataset de validation
nb_lignes <- floor((nrow(diabetes_prediction_dataset)*0.75)) #Nombre de lignes de l’échantillon d’apprentissage : 75% du dataset
diabetes_prediction_dataset <- diabetes_prediction_dataset[sample(nrow(diabetes_prediction_dataset)), ] #Ajout de numéros de lignes
diabetes.train <- diabetes_prediction_dataset[1:nb_lignes, ] #Echantillon d’apprentissage
diabetes.test <- diabetes_prediction_dataset[(nb_lignes+1):nrow(diabetes_prediction_dataset), ] #Echantillon de testVoici ci-dessous les résultats du modèle entraîné sur le dataset d’entraînement. Cet arbre de décision est volumineux et va donc avoir besoin d’un élagage afin de réduire sa complexité. Pour cela, nous allons faire appel à la formule du coût de complexité. Il s’agit d’un paramètre qui permet de contrôler la taille maximale de l’arbre de décision, c’est-à-dire le nombre maximal de nœuds ou de feuilles dans l’arbre.
En général, un arbre de décision plus complexe peut mieux s’adapter aux données d’entraînement, mais il est également plus susceptible de surapprendre (overfitting) et de mal généraliser aux nouvelles données. Par conséquent, le coût de complexité est souvent utilisé pour éviter le surapprentissage en régularisant le modèle et en limitant sa complexité.
set.seed(12)
#Construction de l’arbre
diabetes.Tree <- rpart(diabetes~.,
data=diabetes.train,
method= "class",
control=rpart.control(minsplit=8,cp=0))
#Affichage du résultat
rpart.plot(diabetes.Tree)
Pour bien élaguer notre arbre de décision, nous allons chercher le coût de complexité (cp) pour lequel le taux de mauvais classement (xerror) est la plus faible.
#On cherche à minimiser l’erreur pour définir le niveau d’élagage
#plotcp(diabetes.Tree)
printcp(diabetes.Tree)##
## Classification tree:
## rpart(formula = diabetes ~ ., data = diabetes.train, method = "class",
## control = rpart.control(minsplit = 8, cp = 0))
##
## Variables actually used in tree construction:
## [1] age blood_glucose_level bmi
## [4] gender HbA1c_level heart_disease
## [7] hypertension smoking_history
##
## Root node error: 6339/75000 = 0.08452
##
## n= 75000
##
## CP nsplit rel error xerror xstd
## 1 4.5780e-01 0 1.00000 1.00000 0.0120175
## 2 2.1155e-01 1 0.54220 0.54220 0.0090341
## 3 5.2585e-04 2 0.33065 0.33065 0.0071207
## 4 4.7326e-04 11 0.32418 0.33065 0.0071207
## 5 3.5495e-04 14 0.32276 0.33412 0.0071568
## 6 3.1551e-04 20 0.32056 0.33602 0.0071765
## 7 2.6292e-04 29 0.31772 0.33854 0.0072026
## 8 2.5635e-04 32 0.31693 0.34422 0.0072610
## 9 2.5241e-04 58 0.30904 0.34501 0.0072690
## 10 2.3663e-04 71 0.30525 0.34690 0.0072884
## 11 2.2536e-04 87 0.30068 0.34800 0.0072996
## 12 2.1034e-04 95 0.29879 0.35006 0.0073204
## 13 1.9719e-04 98 0.29815 0.35274 0.0073476
## 14 1.8930e-04 102 0.29737 0.35321 0.0073523
## 15 1.6902e-04 121 0.29342 0.35400 0.0073603
## 16 1.5775e-04 135 0.29106 0.36441 0.0074643
## 17 1.3146e-04 229 0.27307 0.37388 0.0075575
## 18 1.2620e-04 238 0.27181 0.38113 0.0076281
## 19 1.1832e-04 245 0.27071 0.38271 0.0076434
## 20 1.1268e-04 278 0.26613 0.38997 0.0077130
## 21 1.0517e-04 384 0.25051 0.39012 0.0077145
## 22 9.8596e-05 414 0.24688 0.39170 0.0077296
## 23 9.4652e-05 422 0.24610 0.39218 0.0077341
## 24 7.8877e-05 429 0.24499 0.40921 0.0078944
## 25 6.7609e-05 535 0.23553 0.41347 0.0079339
## 26 6.3101e-05 544 0.23490 0.41805 0.0079761
## 27 5.2585e-05 572 0.23300 0.42735 0.0080611
## 28 4.5072e-05 650 0.22843 0.43130 0.0080968
## 29 3.9438e-05 671 0.22748 0.44360 0.0082071
## 30 3.5056e-05 719 0.22527 0.44518 0.0082211
## 31 3.1551e-05 748 0.22417 0.44755 0.0082421
## 32 2.6292e-05 838 0.22117 0.45275 0.0082880
## 33 2.2536e-05 868 0.22038 0.45638 0.0083198
## 34 1.9719e-05 875 0.22022 0.45701 0.0083253
## 35 1.7528e-05 907 0.21959 0.45749 0.0083294
## 36 1.5775e-05 916 0.21944 0.45843 0.0083377
## 37 0.0000e+00 926 0.21928 0.45875 0.0083404Le coût de complexité optimal pour ce modèle va s’afficher sous ce paragraphe. Ce paramètre va ensuite être utilisé pour élaguer l’arbre obtenu précédemment.
print(diabetes.Tree$cptable[which.min(diabetes.Tree$cptable[,4]),1])## [1] 0.0005258453Voici donc ci-dessous le résultat de l’élagage de l’arbre de décision. Ce nouvel arbre est plus court et donc, plus généraliste et aura par conséquence moins tendance à overfitter.
set.seed(12)
#Elagage de l’arbre avec le cp optimal
diabetes.Tree_Opt <- prune(diabetes.Tree,cp=diabetes.Tree$cptable[which.min(diabetes.Tree$cptable[,4]),1])
#Représentation graphique de l’arbre optimal
rpart.plot(diabetes.Tree_Opt)
Enfin, nous avons entrainé le modèle obtenu sur le dataset de test que nous avions précédemment créé. Ensuite, nous avons réalisé plusieurs tests statistiques sur les prédictions qu’il a pu faire.
Les résultats de l’arbre de décision montrent une performance globalement élevée, avec une précision (accuracy) de 97.22%. On peut être satisfait de la capacité du modèle à discriminer entre les classes, avec une sensibilité de 100% pour la classe positive (1) et une spécificité de 97.04% pour la classe négative (0). Le coefficient Kappa de 0.793 indique un accord significatif entre les prédictions du modèle et les valeurs réelles. Ces résultats me donnent confiance dans la compétence du modèle à effectuer des prédictions précises.
#Prédiction du modèle sur les données de test
diabetes.test_Predict<-predict(diabetes.Tree_Opt,newdata=diabetes.test, type= "class")
#Création d'un tableau de confusion
confusionMatrix(diabetes.test$diabetes, diabetes.test_Predict, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 22839 0
## 1 717 1444
##
## Accuracy : 0.9713
## 95% CI : (0.9692, 0.9734)
## No Information Rate : 0.9422
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.7863
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 1.00000
## Specificity : 0.96956
## Pos Pred Value : 0.66821
## Neg Pred Value : 1.00000
## Prevalence : 0.05776
## Detection Rate : 0.05776
## Detection Prevalence : 0.08644
## Balanced Accuracy : 0.98478
##
## 'Positive' Class : 1
##